00100		DIMENSION II(1000),JJ(1000),KK(1000),LL(1000),KP(5),NN(4000)
00200		1,A(400),B(400),IB(400)
00300		COMMON KP,NP,NN
00400		IMP(I)=IABS(NN(I)/100000000)
00500	1	JE=0
00600		MN=0
00700		IP=-1
00800		MO=0
00900		NZ=10
01000		IM=0
01100		NF=1
01200		CALL DPYCLR
01300		CALL TYPLOC(-350,-511)
01400		DO 407 I=1,4
01500	407	KP(I)='     '
01600		CALL DPYSET(4,LL,1000)
01700		CALL DPYSET(3,KK,1000)
01800		CALL DPYSET(2,JJ,1000)
01900		CALL DPYSET(1,II,1000)
02000		MN=0
02100	2	TYPE 5
02200	5	FORMAT(' TYPE:<CR>;TO DRAW NEW PICTURE.'/
02300		1' OR TYPE IN NAME TO USE OLD PICTURE.'/)
02400		ACCEPT 3,NAM
02500	3	FORMAT(A5)
02600		IF(NAM.EQ.'     ')GO TO 140
02700	   	IF(.NOT.LOOKD(NAM))GO TO 2
02800	515	CALL IFILE(1,NAM)
02900		READ(1)LE,(NN(K),K=MN+1,MN+LE)
03000		MN=MN+LE
03100		IP=-1
03200		IF(MO.NE.'P')GO TO 517
03300		MO=100000000
03400		DO 518 K=MN-LE+1,MN
03500		MP=1
03600		IF(NN(K))MP=-1
03700		NN(K)=IABS(NN(K))
03800	518	NN(K)=MP*(NP*MO+(MOD(NN(K),MO)))
03900		GO TO 503
04000	517	DO 388 K=1,MN
04100		NP=IMP(K)
04200		CALL SETPOG(NP)
04300		CALL INXY(NX,NY,K)
04400		MP=1
04500		IF(NN(K))MP=-1
04600	388	CALL IPEN(NX,NY,MP,NZ)
04700	   	DO 193 I=1,4
04800		KP(I)='VIS  '
04900	193	CALL DPYOUT(I)
05000		CALL SETPOG(1)
05100	140	NP=1
05200		CALL IPOG(NZ)
05300	
05400	211	NS=0
05500	120	LV=0
05600	144	CALL SETCUR(NX,NY,LV)
05700		IF(NS)TYPE 6
05800	6	FORMAT(' :'$)
05900		ACCEPT 103,M,N
06000	103	FORMAT(2A1)
06100		LX=NX
06200		LY=NY
06300		CALL RDCUR(NX,NY)
06400		IF(NC)GO TO 191
06500		IF(M.NE.' ')GO TO 11
06600	308	IF(LV.NE.0)GO TO 192
06700	301	CALL IPAK(NX,NY,MN,1,NZ)
06800		LV=1
06900		GO TO 144
07000	192 	CALL IPAK(NX,NY,MN,-1,NZ)
07100	341	N=NP
07200	278	CALL DPYOUT(N)
07300		KP(N)='VIS  '
07400	360	IF(IP)CALL IPOG(NZ)
07500	260	IF(NS)GO TO 144
07600		GO TO 120
07700	
07800	11	IF(M.EQ.':')GO TO 261
07900		IF(M.EQ.'.')GO TO 303
08000		IF(M.EQ.'W')GO TO 380
08100	  	IF(M.EQ.'H')GO TO 306
08200		IF(M.EQ.'V')GO TO 307
08300		IF(M.EQ.'B')GO TO 105
08400	  	IF(M.EQ.'C')GO TO 150
08500		IF(M.EQ.'+')GO TO 500
08600		IF(M.EQ.'-')GO TO 501
08700		IF(M.EQ.'*')GO TO 502
08800		IF(M.EQ.'J')GO TO 608
08900		IF(M.EQ.'A')GO TO 510
09000		IF(M.EQ.'E')GO TO 425
09100		IF(M.EQ.'(')GO TO 431
09200		IF(M.EQ.')')GO TO 432
09300	  	IF(M.EQ.'I'.OR.M.EQ.'S')GO TO 230
09400		IF(M.EQ.'X')GO TO 104
09500		IF(M.EQ.'Z')GO TO 580
09600		IF(M.EQ.'F')GO TO 601
09700		IF(M.NE.'P')GO TO 260
09800		IP=-1
09900		IF(N.EQ.'I')GO TO 258
10000		IF(N.EQ.'D')GO TO 340
10100		IF(N.NE.' ')GO TO 231
10200	259	NP=NP+1
10300		IF(NP.GT.4)NP=1
10400	251	CALL SETPOG(NP)
10500		GO TO 503
10600	303	IF(LV.EQ.0)GO TO 301
10700		CALL IPAK(NX,NY,MN,-1,NZ)
10800	333	KP(NP)='VIS  '
10900		IF(IP)CALL IPOG(NZ)
11000		CALL DPYOUT(NP)
11100		NX=LX
11200		NY=LY
11300		IF(.NOT.NC)GO TO 301
11400		NC=0
11500		GO TO 211
11600	601	I=0
11700	602	I=I+1
11800		IF(I.GT.MN)GO TO 360
11900		IF(IMP(I).NE.NP)GO TO 602	
12000		K=0
12100	606	K=K+1
12200		CALL INXY(N,M,I)
12300		A(K)=N*NZ/10
12400		B(K)=M*NZ/10
12500		IB(K)=3
12600		IF(NN(I))IB(K)=2
12700		I=I+1
12800		IF(I.LE.MN)GO TO 606
12900		IB(1)=K
13000		CALL FILLER(A,B,IB,6,NP)
13100		GO TO 341
13200	608	IF(.NOT.NS)GO TO 341
13300		NS=0
13400		CALL IPAK(JX,JY,MN,-1,NZ)
13500		GO TO 341
13600	306	NY=LY
13700		GO TO 308
13800	307	NX=LX
13900		GO TO 308
14000	230	IF(N.EQ.' ')GO TO 258
14100	231	IF(N.LT.'1'.OR.N.GT.'4')GO TO 255
14200		REREAD 408,M,N
14300	408	FORMAT(A1,I1)
14400		IF(M.EQ.'S')GO TO 278
14500	   	IF(M.NE.'I')GO TO 256
14600	257	KP(N)='     '
14700		CALL HYDPOG(N)
14800		IF(M.EQ.'P')GO TO 259
14900		GO TO 360
15000	255	IF(M.EQ.'P')GO TO 259
15100	258	IF(M.EQ.'S')GO TO 341
15200		N=NP
15300		GO TO 257
15400	256	NP=N
15500		GO TO 251
15600	261	IF(NS)GO TO 211
15700		NS=-1
15800		JX=NX
15900		JY=NY
16000		IF(LV.EQ.1)GO TO 192
16100		GO TO 301
16200	580	IF(IP)GO TO 581
16300		IP=-1
16400		GO TO 360
16500	581	IP=0
16600		N=5
16700		GO TO 257
16800	500	IF(NZ.EQ.20)GO TO 503
16900		NZ=NZ+1
17000		GO TO 503
17100	501	IF(NZ.EQ.5)GO TO 503
17200		NZ=NZ-1
17300		GO TO 503
17400	502	IF(NZ.EQ.10)GO TO 503
17500		NZ=10
17600	503	CALL CLRPOG(NP)
17700		CALL IDRA(MN,NZ)
17800		GO TO 335
17900	510	REREAD 516,MO,NAM
18000	516	FORMAT(1XA1,A5)
18100		IF(.NOT.LOOKD(NAM))GO TO 260
18200		GO TO 515
18300	340	CALL CLRPOG(NP)
18400		J=0
18500	400	J=J+1
18600	507	IF(J.GT.MN)GO TO 466
18700		MP=IMP(J)
18800		IF(MP.NE.NP)GO TO 400
18900		DO 401 I=J,MN-1
19000	401	NN(I)=NN(I+1)
19100		MN=MN-1
19200		GO TO 507
19300	466	IF(JE)GO TO 467
19400		IP=-1
19500		GO TO 431
19600	105	IF(MN.LT.1.OR.IMP(MN).NE.NP)GO TO 335
19700		IF(NP.EQ.1)II(2)=II(2)-1
19800		IF(NP.EQ.2)JJ(2)=JJ(2)-1
19900		IF(NP.EQ.3)KK(2)=KK(2)-1
20000		IF(NP.EQ.4)LL(2)=LL(2)-1
20100	        CALL ACCPOG(NP)
20200		MN=MN-1
20300	335	NS=0
20400		GO TO 341
20500	150	NC=-1
20600		IF(LV.NE.1)GO TO 301
20700	191	R=0
20800		RM=(NX-LX)**2+(NY-LY)**2
20900		RM=SQRT(RM)
21000		KX=LX+RM*SIND(R)
21100		KY=LY+RM*COSD(R)
21200		CALL IPAK(KX,KY,MN,1,NZ)
21300		DO 151 K=6,360,6
21400		R=K
21500		KX=LX+RM*SIND(R)
21600		KY=LY+RM*COSD(R)
21700	151	CALL IPAK(KX,KY,MN,-1,NZ)
21800		GO TO 333
21900	380	IF(LV.NE.1)GO TO 103
22000		REREAD 377,M,N
22100	377	FORMAT(A1,I2)
22200		IF(N.LT.4)N=100
22300		KN=N/10
22400		IF(KN.LT.2)KN=2
22500		DO 381 I=0,N,KN
22600		CALL IPAK(LX-N/2+I,LY-N/2+I,MN,1,NZ)
22700	381	CALL IPAK(NX-N/2+I,NY-N/2+I,MN,-1,NZ)
22800		GO TO 341
22900	425	I=0
23000	426	I=I+1
23100		IF(I.GT.MN)GO TO 211
23200	430	IF(IMP(I).NE.NP)GO TO 426
23300	548	CALL INXY(NX,NY,I)
23400		CALL SETCUR(NX*NZ/10,NY*NZ/10,1)
23500		TYPE 469
23600	469	FORMAT(' ERASE?'$)
23700		ACCEPT 103,M,N
23800		IF(M.EQ.' ')GO TO 426
23900		IF(M.EQ.'Y')GO TO 470
24000		IF(M.EQ.'I')GO TO 547
24100		IF(M.NE.'B')GO TO 211
24200	549	I=I-1
24300		IF(I.LT.1)GO TO 211
24400		IF(IMP(I).NE.NP)GO TO 549
24500		GO TO 548
24600	547	NN(I)=IABS(NN(I))
24700		GO TO 471
24800	470	MN=MN-1
24900		DO 428 K=I,MN
25000	428	NN(K)=NN(K+1)
25100	471	CALL CLRPOG(NP)
25200		CALL IDRA(MN,NZ)
25300		CALL DPYOUT(NP)
25400		GO TO 430
25500	431	NX=0
25600		NY=0
25700		NF=MN+1
25800		IM=0
25900		GO TO 211
26000	432	IF(IM.EQ.0)IM=MN
26100		DO 433 I=NF,IM
26200		CALL INXY(IX,IY,I)
26300		IX=NX+IX
26400		IY=NY+IY
26500		MP=1
26600		IF(NN(I))MP=-1
26700	433	CALL IPAK(IX,IY,MN,MP,NZ)
26800		GO TO 341
26900	
27000	104	CALL CLRCUR
27100		CALL IPOG(NZ)
27200		IP=-1
27300	   	TYPE 111
27400	111	FORMAT(' TYPE:<CR>;TO CONTINUE.'/' TYPE:''N''<CR>;TO START OVER.'/
27500		2' TYPE:''X'' TO SAVE VIS POGS IF FINISHED'/
27600		3' OR TYPE:''P'' TO PLOT ALL VIS POGS'/)
27700		ACCEPT 103,M,N
27800		IF(M.EQ.'N')GO TO 1
27900		IF(M.EQ.'P')GO TO 557
28000		IF(M.NE.'X')GO TO 120
28100	127	TYPE 121
28200	121	FORMAT(' TYPE A FIVE LETTER NAME FOR THIS PICTURE.'/)
28300		ACCEPT 3,NAM
28400		IF(NAM.EQ.'     ')GO TO 127
28500	557	MP=0
28600		DO 405 NP=1,4
28700		IF(KP(NP).NE.'VIS  ')GO TO 405
28800		MP=MP+1
28900		CALL IPAK(0,0,MN,1,10)
29000	405	CONTINUE
29100		IF(MP.EQ.0)GO TO 104
29200		NP=0
29300		JE=-1
29400	467	NP=NP+1
29500		IF(NP.GT.4)GO TO 468
29600		IF(KP(NP).NE.'VIS  ')GO TO 340
29700		GO TO 467
29800	468	IF(M.EQ.'P')GO TO 555
29900		CALL OFILE(1,NAM)
30000		WRITE(1)MN,(NN(K),K=1,MN)
30100		END FILE 1
30200		GO TO 1
30300	555	TYPE 587
30400	587	FORMAT(/' PLOTING ALL VIS POGS'/)
30500		CALL PLOTS(I)
30600		DO 556 I=1,MN
30700		CALL INXY(NX,NY,I)
30800		MO=3
30900		IF(NN(I))MO=2
31000	556	CALL PLOT(NX*NZ/10,NY*NZ/10,MO)
31100		GO TO 1
31200		END
31300	
31400		SUBROUTINE IPOG(NZ)
31500		COMMON KP(5),NP,NN(4000)
31600		DIMENSION MM(30),JP(4)
31700		CALL DPYSET(5,MM,30)
31800		CALL DPYTXT(100,-430,'POG1 POG2 POG3 POG4 ZOOM ',5)
31900		KP(5)=' REG '
32000		IF(NZ.LT.10)KP(5)=' --- '
32100		IF(NZ.GT.10)KP(5)=' +++ '
32200		CALL DPYTXT(100,-450,KP,5)
32300		DO 4 J=1,4
32400		JP(J)='     '
32500	4	IF(J.EQ.NP)JP(J)=' ↑↑  '
32600		CALL DPYTXT(100,-470,JP,4)
32700		CALL DPYOUT(5)
32800		CALL SETPOG(NP)
32900		RETURN
33000		END
33100		SUBROUTINE IPAK(NX,NY,MN,MP,NZ)
33200		COMMON KP(5),NP,NN(4000)
33300		MN=MN+1
33400		IX=(NX*10/NZ)+1024
33500		IY=(NY*10/NZ)+1024
33600		NN(MN)=MP*(NP*100000000+IX*10000+IY)
33700		CALL IPEN(NX,NY,MP,10)
33800		RETURN
33900		END
34000		SUBROUTINE IPEN(NX,NY,MP,NZ)
34100		IX=NX*NZ/10
34200		IF(IX.GT.950)IX=950
34300		IF(IX.LT.-950)IX=-950
34400		IY=NY*NZ/10
34500		IF(IY.GT.950)IY=950
34600		IF(IY.LT.-950)IY=-950
34700		IF(MP)GO TO 1
34800		CALL AIVECT(IX,IY)
34900		RETURN
35000	1	CALL AVECT(IX,IY)
35100		RETURN
35200		END
35300		SUBROUTINE INXY(NX,NY,MN)
35400		COMMON KP(5),NP,NN(4000)
35500		J=IABS(NN(MN))
35600		NY=MOD(J,10000)-1024
35700		NX=(MOD(J,100000000)/10000)-1024
35800		RETURN
35900		END
36000		SUBROUTINE IDRA(MN,NZ)
36100		COMMON KP(5),NP,NN(4000)
36200		DO 1 I=1,MN
36300		IF(IABS(NN(I)/100000000).NE.NP)GO TO 1
36400		CALL INXY(IX,IY,I)
36500		CALL IPEN(IX,IY,NN(I),NZ)
36600	1	CONTINUE
36700		RETURN
36800		END